home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / PROMPT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  3KB  |  112 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 573 of 581
  3. From : John Giesbrecht                     1:247/128.0          17 May 93  21:27
  4. To   : Marvin Hart
  5. Subj : Shelling and prompt
  6. ────────────────────────────────────────────────────────────────────────────────}
  7. {$A+,B-,F-,L-,N-,O-,R-,S-,V-}
  8.  
  9. unit prompt;
  10.  
  11. {
  12.  
  13. Author:   Trevor J Carlsen
  14.           PO Box 568
  15.           Port Hedland
  16.           Western Australia 6721
  17.           61-[0]-91-73-2026  (voice)
  18.           61-[0]-91-73-2930  (data )
  19.           
  20. Released into the public domain.
  21.  
  22. This unit will automatically create a predefined prompt when shelling to DOS.
  23. If you wish to create your own custom prompt, all that is required is to give
  24. the variable NewPrompt another value and call the procedure ChangeShellPrompt.
  25.  
  26. }
  27.  
  28. interface
  29.  
  30. uses dos;
  31.  
  32. var
  33.   NewPrompt : string;
  34.  
  35. procedure ChangeShellPrompt(Nprompt: string);
  36.  
  37. implementation
  38.  
  39.  type
  40.    EnvArray  = array[0..32767] of byte;
  41.    EnvPtr    = ^EnvArray;
  42.  var
  43.    EnvSize, EnvLen, EnvPos: word;
  44.    NewEnv, OldEnv         : EnvPtr;
  45.    TempStr                : string;
  46.    x                      : word;
  47.  
  48.  procedure ChangeShellPrompt(Nprompt: string);
  49.  
  50.    function MainEnvSize: word;
  51.      var
  52.        x      : word;
  53.        found  : boolean;
  54.      begin
  55.        found  := false; x := 0;
  56.        repeat
  57.          if (OldEnv^[x] = 0) and (OldEnv^[x+1] = 0) then
  58.            found := true
  59.          else
  60.            inc(x);
  61.        until found;
  62.        MainEnvSize := x - 1;
  63.      end; { MainEnvSize}
  64.  
  65.    procedure AddEnvStr(var s; var offset: word; len: word);
  66.      var st : EnvArray absolute s;
  67.      begin
  68.        move(st[1],NewEnv^[offset],len);
  69.        inc(offset,len+1);
  70.      end;
  71.  
  72.  begin
  73.    OldEnv   := ptr(MemW[PrefixSeg:$2C],0);
  74.    { this gets the actual starting segment of the current program's env }
  75.  
  76.    EnvSize      :=  MemW[seg(OldEnv^)-1:3] shl 4;
  77.    { Find the size of the current environment }
  78.  
  79.    if MaxAvail < (EnvSize+256) then begin
  80.      writeln('Insufficient memory');
  81.      halt;
  82.    end;
  83.  
  84.    GetMem(NewEnv, EnvSize + $100);
  85.    if ofs(NewEnv^) <> 0 then begin
  86.       inc(longint(NewEnv),$10000 + ($10000 * (longint(NewEnv) div 16)));
  87.       longint(NewEnv) := longint(NewEnv) and $ffff0000;
  88.    end;
  89.    FillChar(NewEnv^,EnvSize + $100,0);
  90.    { Allocate heap memory for the new environment adding enough to allow }
  91.    { alignment to a paragraph boundary or a longer prompt than the default }
  92.    { and initialise to nuls }
  93.    EnvPos   := 0;
  94.  
  95.    AddEnvStr(Nprompt,EnvPos,length(Nprompt));
  96.    for x := 1 to EnvCount do begin
  97.      TempStr := EnvStr(x);
  98.      if TempStr <> GetEnv('PROMPT') then
  99.        AddEnvStr(TempStr,EnvPos,length(TempStr));
  100.    end; { for }
  101.    inc(EnvPos);
  102.    { Transfer old env strings except the prompt to new environment }
  103.  
  104.    if lo(DosVersion) > 2 then
  105.      AddEnvStr(OldEnv^[MainEnvSize + 2],EnvPos,EnvSize-(MainEnvSize + 2));
  106.    { Add the rest of the environment }
  107.  
  108.    MemW[PrefixSeg:$2C] := seg(NewEnv^);
  109.    { let the program know where the new environment is }
  110.  end;  { ChangeShellPrompt }
  111.  
  112. end.  { prompt }